library(SingleCellExperiment)

## Loading required package: SummarizedExperiment

## Loading required package: MatrixGenerics

## Loading required package: matrixStats

## 
## Attaching package: 'MatrixGenerics'

## The following objects are masked from 'package:matrixStats':
## 
##     colAlls, colAnyNAs, colAnys, colAvgsPerRowSet, colCollapse,
##     colCounts, colCummaxs, colCummins, colCumprods, colCumsums,
##     colDiffs, colIQRDiffs, colIQRs, colLogSumExps, colMadDiffs,
##     colMads, colMaxs, colMeans2, colMedians, colMins, colOrderStats,
##     colProds, colQuantiles, colRanges, colRanks, colSdDiffs, colSds,
##     colSums2, colTabulates, colVarDiffs, colVars, colWeightedMads,
##     colWeightedMeans, colWeightedMedians, colWeightedSds,
##     colWeightedVars, rowAlls, rowAnyNAs, rowAnys, rowAvgsPerColSet,
##     rowCollapse, rowCounts, rowCummaxs, rowCummins, rowCumprods,
##     rowCumsums, rowDiffs, rowIQRDiffs, rowIQRs, rowLogSumExps,
##     rowMadDiffs, rowMads, rowMaxs, rowMeans2, rowMedians, rowMins,
##     rowOrderStats, rowProds, rowQuantiles, rowRanges, rowRanks,
##     rowSdDiffs, rowSds, rowSums2, rowTabulates, rowVarDiffs, rowVars,
##     rowWeightedMads, rowWeightedMeans, rowWeightedMedians,
##     rowWeightedSds, rowWeightedVars

## Loading required package: GenomicRanges

## Loading required package: stats4

## Loading required package: BiocGenerics

## Loading required package: parallel

## 
## Attaching package: 'BiocGenerics'

## The following objects are masked from 'package:parallel':
## 
##     clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
##     clusterExport, clusterMap, parApply, parCapply, parLapply,
##     parLapplyLB, parRapply, parSapply, parSapplyLB

## The following objects are masked from 'package:stats':
## 
##     IQR, mad, sd, var, xtabs

## The following objects are masked from 'package:base':
## 
##     anyDuplicated, append, as.data.frame, basename, cbind, colnames,
##     dirname, do.call, duplicated, eval, evalq, Filter, Find, get, grep,
##     grepl, intersect, is.unsorted, lapply, Map, mapply, match, mget,
##     order, paste, pmax, pmax.int, pmin, pmin.int, Position, rank,
##     rbind, Reduce, rownames, sapply, setdiff, sort, table, tapply,
##     union, unique, unsplit, which.max, which.min

## Loading required package: S4Vectors

## 
## Attaching package: 'S4Vectors'

## The following objects are masked from 'package:base':
## 
##     expand.grid, I, unname

## Loading required package: IRanges

## Loading required package: GenomeInfoDb

## Loading required package: Biobase

## Welcome to Bioconductor
## 
##     Vignettes contain introductory material; view with
##     'browseVignettes()'. To cite Bioconductor, see
##     'citation("Biobase")', and for packages 'citation("pkgname")'.

## 
## Attaching package: 'Biobase'

## The following object is masked from 'package:MatrixGenerics':
## 
##     rowMedians

## The following objects are masked from 'package:matrixStats':
## 
##     anyMissing, rowMedians

library(scater)

## Loading required package: scuttle

## Loading required package: ggplot2

library(scran)
library(BiocParallel)
sce <- readRDS("data/sce_preprocessed.rds")

Annotation using SingleR and the Immgen reference

library(SingleR)

ref <- celldex::ImmGenData(ensembl = TRUE)

## snapshotDate(): 2021-05-18

## see ?celldex and browseVignettes('celldex') for documentation

## loading from cache

## see ?celldex and browseVignettes('celldex') for documentation

## loading from cache

## snapshotDate(): 2021-05-18

## loading from cache

## require("ensembldb")

## Warning: Unable to map 782 of 22134 requested IDs.

# ref$label.main


pred <- SingleR(test = sce, ref = ref, 
                labels = ref$label.main, assay.type.test=1,
                BPPARAM = MulticoreParam())

sort(table(pred$labels), decreasing=TRUE)

## 
##       Macrophages  Epithelial cells               NKT Endothelial cells 
##             33060              7802              4102              3460 
##           T cells       Neutrophils               ILC       Fibroblasts 
##              3225              3190              2491              2450 
##                DC           B cells               Tgd          NK cells 
##              1984               863               821               638 
##         Monocytes     Stromal cells        Stem cells        Mast cells 
##               433               315               197               115 
##         Basophils      B cells, pro         Microglia       Eosinophils 
##                29                10                10                 6

plotScoreHeatmap(pred, 
                 annotation_col=as.data.frame(colData(sce)[,"Sample",drop=FALSE]))

tab <- table(cluster=sce$label, label=pred$labels) 
pheatmap::pheatmap(log10(tab+10), main = "Cell labels in cluster",
                   color             = rev(viridis::rocket(20)))

tab <- table(cluster=sce$Sample, label=pred$labels) 
pheatmap::pheatmap(log10(tab+10), main = "log10 cell numbers",
                   color             = rev(viridis::rocket(20)))

pheatmap::pheatmap(prop.table(tab, margin = 1)*100, main="Percent by condition",
                   color             = rev(viridis::rocket(20)))

sce$label_immgen <- pred$labels

UMAP with cell annotation

plotUMAP(sce, colour_by="label_immgen", other_fields="Sample", text_by="label_immgen", text_size=4) + coord_fixed()

plotUMAP(sce, colour_by="label_immgen", other_fields="Sample") + facet_wrap(~Sample) + coord_fixed()

plotUMAP(sce, colour_by="label", other_fields="Sample", text_by="label_immgen", text_size=4) + coord_fixed()

For Figure

sce$label_immgen_collapsed <- forcats::fct_collapse(
  sce$label_immgen,
  "B cells" = c("B cells", "B cells, pro"),
  "Unconventional T cells" = c("Tgd", "NKT"),
  "Tumor" = c("Epithelial cells", "Endothelial cells", "Fibroblasts"),
  "Other Granulocytes" = c("Eosinophils", "Basophils", "Mast cells"),
  "Other" = c("Microglia", "Stem cells")
)


plotUMAP(sce, colour_by="label_immgen_collapsed", other_fields="Sample", text_size=4) + coord_fixed() + 
  scale_color_manual(
    name = "Cell type",
    breaks = c(
      "T cells" ,
    "NK cells" ,
    "Unconventional T cells",
    
    "B cells" ,
    "ILC" ,
    
    
    "Macrophages" ,
    "Monocytes",
    "Neutrophils",
    "DC",
    
    "other Granulocytes",
    
    "Tumor",
    "Stromal cells",
    
    
    "Other"
    ), 
    values = c(
      "B cells" = "#8A4198",
      
      "other Granulocytes" = "#D2AF81",
      "ILC" ="#FD8CC1",
      "DC" = "#FED439",
      "Macrophages" = "#1A9993",
      "Monocytes" = "#91331F",
      "Neutrophils" = "#370335",
      
      "Tumor" = "#709AE1",
      "Stromal cells" = "#71D0F5",
        
      "NK cells" = "#46732E",
      "T cells" = "#C80813" ,

      "Unconventional T cells" = "#F05C3B",          
      
      "Other" = "#8A9197"
      )
  ) +
  ggh4x::force_panelsizes(rows = unit(4, "in"),
                   cols = unit(4, "in"))

## Scale for 'colour' is already present. Adding another scale for 'colour',
## which will replace the existing scale.

sort(table(sce$label_immgen), decreasing = TRUE)

## 
##       Macrophages  Epithelial cells               NKT Endothelial cells 
##             33060              7802              4102              3460 
##           T cells       Neutrophils               ILC       Fibroblasts 
##              3225              3190              2491              2450 
##                DC           B cells               Tgd          NK cells 
##              1984               863               821               638 
##         Monocytes     Stromal cells        Stem cells        Mast cells 
##               433               315               197               115 
##         Basophils      B cells, pro         Microglia       Eosinophils 
##                29                10                10                 6

Save RDS

saveRDS(sce, file="data/sce_annotated.rds")

Session info

sessionInfo()

## R version 4.1.3 (2022-03-10)
## Platform: x86_64-redhat-linux-gnu (64-bit)
## Running under: Fedora Linux 36 (Container Image)
## 
## Matrix products: default
## BLAS/LAPACK: /usr/lib64/libflexiblas.so.3.3
## 
## locale:
##  [1] LC_CTYPE=C.UTF-8       LC_NUMERIC=C           LC_TIME=C.UTF-8       
##  [4] LC_COLLATE=C.UTF-8     LC_MONETARY=C.UTF-8    LC_MESSAGES=C.UTF-8   
##  [7] LC_PAPER=C.UTF-8       LC_NAME=C              LC_ADDRESS=C          
## [10] LC_TELEPHONE=C         LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C   
## 
## attached base packages:
## [1] parallel  stats4    stats     graphics  grDevices datasets  utils    
## [8] methods   base     
## 
## other attached packages:
##  [1] ensembldb_2.16.4            AnnotationFilter_1.16.0    
##  [3] GenomicFeatures_1.44.2      AnnotationDbi_1.54.1       
##  [5] celldex_1.2.0               SingleR_1.6.1              
##  [7] BiocParallel_1.26.2         scran_1.20.1               
##  [9] scater_1.20.1               ggplot2_3.3.5              
## [11] scuttle_1.2.1               SingleCellExperiment_1.14.1
## [13] SummarizedExperiment_1.22.0 Biobase_2.52.0             
## [15] GenomicRanges_1.44.0        GenomeInfoDb_1.28.2        
## [17] IRanges_2.26.0              S4Vectors_0.30.0           
## [19] BiocGenerics_0.38.0         MatrixGenerics_1.4.3       
## [21] matrixStats_0.60.1         
## 
## loaded via a namespace (and not attached):
##   [1] AnnotationHub_3.0.1           BiocFileCache_2.0.0          
##   [3] igraph_1.2.6.9118             lazyeval_0.2.2               
##   [5] digest_0.6.27                 htmltools_0.5.2              
##   [7] viridis_0.6.1                 fansi_0.5.0                  
##   [9] magrittr_2.0.1                memoise_2.0.0                
##  [11] ScaledMatrix_1.0.0            cluster_2.1.2                
##  [13] limma_3.48.3                  Biostrings_2.60.2            
##  [15] ggh4x_0.2.1                   rmdformats_1.0.2             
##  [17] prettyunits_1.1.1             colorspace_2.0-2             
##  [19] blob_1.2.2                    rappdirs_0.3.3               
##  [21] xfun_0.25                     dplyr_1.0.7                  
##  [23] crayon_1.4.1                  RCurl_1.98-1.4               
##  [25] jsonlite_1.7.2                glue_1.4.2                   
##  [27] gtable_0.3.0                  zlibbioc_1.38.0              
##  [29] XVector_0.32.0                DelayedArray_0.18.0          
##  [31] BiocSingular_1.8.1            scales_1.1.1                 
##  [33] pheatmap_1.0.12               DBI_1.1.1                    
##  [35] edgeR_3.34.0                  Rcpp_1.0.7                   
##  [37] viridisLite_0.4.0             xtable_1.8-4                 
##  [39] progress_1.2.2                dqrng_0.3.0                  
##  [41] bit_4.0.4                     rsvd_1.0.5                   
##  [43] metapod_1.0.0                 httr_1.4.2                   
##  [45] RColorBrewer_1.1-2            ellipsis_0.3.2               
##  [47] farver_2.1.0                  pkgconfig_2.0.3              
##  [49] XML_3.99-0.7                  sass_0.4.0                   
##  [51] dbplyr_2.1.1                  locfit_1.5-9.4               
##  [53] utf8_1.2.2                    labeling_0.4.2               
##  [55] tidyselect_1.1.1              rlang_0.4.11                 
##  [57] later_1.3.0                   munsell_0.5.0                
##  [59] BiocVersion_3.13.1            tools_4.1.3                  
##  [61] cachem_1.0.6                  generics_0.1.0               
##  [63] RSQLite_2.2.8                 ExperimentHub_2.0.0          
##  [65] evaluate_0.14                 stringr_1.4.0                
##  [67] fastmap_1.1.0                 yaml_2.2.1                   
##  [69] knitr_1.33                    bit64_4.0.5                  
##  [71] purrr_0.3.4                   KEGGREST_1.32.0              
##  [73] sparseMatrixStats_1.4.2       mime_0.11                    
##  [75] xml2_1.3.2                    biomaRt_2.48.3               
##  [77] compiler_4.1.3                beeswarm_0.4.0               
##  [79] filelock_1.0.2                curl_4.3.2                   
##  [81] png_0.1-7                     interactiveDisplayBase_1.30.0
##  [83] tibble_3.1.4                  statmod_1.4.36               
##  [85] bslib_0.2.5.1                 stringi_1.7.4                
##  [87] highr_0.9                     forcats_0.5.1                
##  [89] lattice_0.20-44               bluster_1.2.1                
##  [91] ProtGenerics_1.24.0           Matrix_1.3-4                 
##  [93] vctrs_0.3.8                   pillar_1.6.2                 
##  [95] lifecycle_1.0.0               BiocManager_1.30.16          
##  [97] jquerylib_0.1.4               BiocNeighbors_1.10.0         
##  [99] cowplot_1.1.1                 bitops_1.0-7                 
## [101] irlba_2.3.3                   httpuv_1.6.2                 
## [103] rtracklayer_1.52.1            R6_2.5.1                     
## [105] BiocIO_1.2.0                  bookdown_0.23                
## [107] promises_1.2.0.1              renv_0.15.4                  
## [109] gridExtra_2.3                 vipor_0.4.5                  
## [111] assertthat_0.2.1              rjson_0.2.20                 
## [113] withr_2.4.2                   GenomicAlignments_1.28.0     
## [115] Rsamtools_2.8.0               GenomeInfoDbData_1.2.6       
## [117] hms_1.1.0                     grid_4.1.3                   
## [119] beachmat_2.8.1                rmarkdown_2.10               
## [121] DelayedMatrixStats_1.14.3     shiny_1.6.0                  
## [123] ggbeeswarm_0.6.0              restfulr_0.0.13

Beta-1 adrenergic receptor links sympathetic nerves to T cell exhaustion: Part 2

Last compiled on 17 August, 2023

Annotation using SingleR and the Immgen reference

UMAP with cell annotation

For Figure

Save RDS

Session info